
'批量拆分合并单元格
Sub unmergeCells(control As IRibbonControl)

    Dim rng As Range
    Set rng = Selection '存储选区到内存中，否则后续在定位空白单元格时可能会重置选区
    With rng
        Dim 方向 As String
        If .Cells.Columns.Count = 1 Then
            方向 = "向下"
        ElseIf .Cells.Rows.Count = 1 Then
            方向 = "向右"
        Else
            Dim msg
            msg = MsgBox("合并单元格之前是向下合并的么？选否则为向右合并的", vbYesNoCancel)
            If msg = vbYes Then
                方向 = "向下"
            ElseIf msg = vbNo Then
                方向 = "向右"
            End If
        End If

        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .mergeCells = False
        Dim nf As Variant
        nf = .NumberFormat      '可能为Null
        .NumberFormatLocal = "G/通用格式"           ' 需要转换为常规格式才可以使用公式，文本格式的内容无法使用公式
        
        On Error Resume Next        '防止找不到空单元格报错
        If 方向 = "向下" Then
            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        ElseIf 方向 = "向右" Then
            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"
        End If
        
        .Copy
        .PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        .NumberFormat = nf          ' 将之前的数字格式粘贴过来
        
    End With

End Sub

'批量合并单元格
Sub mergeCells(control As IRibbonControl)

    If InStr(Selection.Address(0, 0), ":") Then         '如果是多个单元格
        Dim 方向 As String
        Dim rng As Range
        Set rng = Selection
        Dim rs As Long, cs As Long
        rs = rng.Cells.Rows.Count
        cs = rng.Cells.Columns.Count

        '判断合并方向
        If cs = 1 Then             ' 只有一列数据时
            方向 = "向下"
        ElseIf rs = 1 Then       ' 只有一行数据时
            方向 = "向右"
        Else                            ' 多行多列数据时，由用户手动选择
            Dim msg
            msg = MsgBox("是否向下合并单元格？否则向右合并", vbYesNoCancel)
            If msg = vbYes Then
                方向 = "向下"
            ElseIf msg = vbNo Then
                方向 = "向右"
            End If
        End If

        ' 此时必会执行合并单元格操作
        Application.DisplayAlerts = False
        Dim r As Long, c As Long        ' 初始单元格的坐标
        With Range(Split(rng.Address(0, 0), ":")(0))
            r = .Row
            c = .Column
        End With

        Dim Lastval As Variant, nextVal As Variant
        Dim m As Long, n As Long
        Dim i As Long, j As Long

        If 方向 = "向下" Then

            For j = 0 To cs - 1

                n = 0
                Do While n < rs
                    m = n: n = m + 1        ' 从上一个不同值的单元格坐标开始这一次的判断
                    Lastval = Cells(r + m, c + j).Value
                    nextVal = Cells(r + n, c + j).Value
                    Do While Lastval = nextVal And n < rs
                        n = n + 1
                        nextVal = Cells(r + n, c + j).Value
                    Loop

                    ' 合并及居中两者之间的所有单元格
                    With Range(Cells(r + m, c + j), Cells(r + n - 1, c + j))
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                        .mergeCells = True
                    End With

                Loop
            Next

        ElseIf 方向 = "向右" Then

            For i = 0 To rs - 1
                n = 0

                Do While n < cs
                    m = n: n = m + 1
                    Lastval = Cells(r + i, c + m).Value
                    nextVal = Cells(r + i, c + n).Value
                    Do While Lastval = nextVal And n < cs
                        n = n + 1
                        nextVal = Cells(r + i, c + n).Value
                    Loop

                    With Range(Cells(r + i, c + m), Cells(r + i, c + n - 1))
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                        .mergeCells = True
                    End With

                Loop
            Next

        End If
        Application.DisplayAlerts = True
    End If

End Sub